home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr36 / mapl0301.zip / MENUPLUS.BAS < prev    next >
BASIC Source File  |  1993-04-13  |  13KB  |  299 lines
  1. ' $linesize:132
  2. ' $title: 'MenuPlus.BAS 17.4, Copyright 1992'
  3. '  Copyright  (c) 1992 by Scott Thompson
  4. '  Name ...............: MenuPlus.BAS
  5. '  First Released .....: Feb 4, 1993 for Maple code
  6. '  Subsequent Releases.: Feb 19, 1993 for Maple code by Scott Thompson
  7. '  Copyright ..........: (c) 1992 by Scott Thompson
  8. '                        mods for Maple code (c) Rich Taft 1993
  9. '                        additional mods by Peter Eibl (c) 1993
  10. '
  11. '  Purpose.............: adds a nice menu0 screen to RBBS
  12. '                       
  13. '                       
  14. '
  15. '  Parameters..........: Most parameters are passed via a COMMON statement.
  16. '
  17. ' $SUBTITLE: 'MenuPlus - adds nice menu to RBBS 17.4 MAple version'
  18. ' $PAGE         (c) 1992 by Scott Thompson
  19. '               additional  mods (c) by Pete Eibl and Richard Taft 1993
  20. '
  21. ' $INCLUDE: 'RBBS-VAR.MOD'
  22. '  SUBPROGRAM NAME    -- MenuPlus
  23. '
  24. '
  25. '  SUBPROGRAM PURPOSE --  nice menu for RBBS
  26.  
  27. Sub MenuPlus (PR)  Static
  28.  
  29.      On PR GOTO 10,20,30,40,50,60,50,80,90,95,97          'MENU1748 &'RT020993
  30.      GOTO 99
  31.  
  32. 10   ZMenuNewUsers = ZMenuNewUsers + 1                               'MENU174
  33.      Exit Sub
  34.     
  35.  
  36. 20  IF (NOT ZExitToDoors) AND (NOT ZSubBoard) THEN _                 'MENU1741
  37.     ZMenuNewCalls = ZMenuNewCalls + 1                                'MENU174
  38.     Exit Sub
  39.  
  40. 30  CALL AMorPM                                                      'MENU1747
  41.      ZMenuNewDate$ = ZCurDate$                                    'Pe020993
  42.      ZMenuNewTime$ = ZTime$                                       'Pe020993
  43.      IF ZOrigUserName$ = ZSecretName$ THEN                            'MENU174
  44.      ZMenuNewUpld = 0                                             'MENU174
  45.      ZMenuNewUsers = 0                                            'MENU174
  46.      ZMenuNewCalls = 0                                            'MENU174
  47.      ZMenuNewSysop = 0                                            'MENU174
  48.      ZMenuNewDSC = 0                                              'MENU1747
  49.      ZMenuNewDl = 0                                               'MENU1747
  50.      ZMenuNewDSL = 0                                              'MENU1748
  51.      CALL PutCom (ZBellRinger$)                                   'MENU174
  52.      CALL QuickTPut1 (ZFG1$ + "SYSOP New Stats Reset.")           'MENU174
  53.      END IF                                                          'MENU174
  54.      Exit Sub
  55.  
  56. 40   ZMenuNewSysop = ZMenuNewSysop + 1                               'MENU174
  57.      Exit Sub
  58.      
  59. 50   CALL GetTime                                                    'RT020993
  60.      CALL AMorPM                                                     'RT020993
  61.      Mins! = (ZSessionHour * 60) + ZSessionMin                        'RT020993
  62.      CALL OpenOutW ("MENUNEW" + ZNodeFileID$ + ".DEF")               'MENU1742
  63.      WRITE #2, ZMenuNewDate$,ZmenuNewTime$,ZMenuNewUpld, _           'MENU174
  64.      ZMenuNewUsers,ZMenuNewCalls,ZMenuNewSysop,ZMenuNewDSC, _    'Pe020993
  65.      ZMenuNewDl,ZMenuNewDSL                                          'MENU1748
  66.      WRITE #2, ZActiveUserName$ + " From: " + _                      'MENU1746
  67.                ZWasCI$ + ". (" + ZTime$ + _                         'MENU1748
  68.                " /" + STR$(Mins!) + " Min.)"                          'MENU1748 & Pe021393
  69.      WRITE #2, TIMER                                                 'RT020993
  70.      Close 2
  71.      Exit Sub
  72.  
  73. 60   ZMenuNewUpld = ZMenuNewUpld + 1                                 'MENU174
  74.      Exit Sub
  75.  
  76.  
  77. 80   CALL FindItX ("MENUNEW" + ZNodeFileID$ + ".DEF",2)              'RT020993
  78.      IF ZOK Then _                                                   'RT020993
  79.      CALL GetMenuNew                                              'MENU1743
  80.      Exit Sub
  81.  
  82. 90   ZMenuNewDL = ZMenuNewDL + 1                                     'MENU1744
  83.      Exit Sub
  84.  
  85. 95   ZMenuNewDSC = ZMenuNewDSC + 1                                   'Pe020993
  86.      Exit Sub
  87.  
  88. 97   ZMenuNewDSL = ZMenuNewDSL + 1                                   'MENU1748
  89.      Exit Sub                                                        'MENU1748
  90.  
  91. 99   END SUB
  92.  
  93.  
  94. 100 ' $SUBTITLE: 'SysMenuPlus - sub to display RBBS-PC SYSOP menu enhnace vrs'
  95. '  $PAGE
  96. '
  97. '  NAME    --  SysMenuPlus
  98. '
  99. '  INPUTS  --  PARAMETER           MEANING
  100. '
  101. '  OUTPUTS --  NONE
  102. '
  103. '  PURPOSE --  TO DISPLAY enhanced SYSOP MENU ON THE LOCAL SCREEN
  104. '
  105.      SUB SysMenuPlus (AOK) STATIC
  106.      AOK = ZTrue
  107.      ZLocalUser = ZTrue
  108.      ZSnoop = ZTrue
  109.      ZNonStop = ZTrue
  110.      CALL CheckTime (TIMER, ZDelay!, 1)
  111.      CLS
  112.      ZStopInterrupts = ZTrue
  113.      ZBypassTimeCheck = ZTrue
  114.      CALL BufFile ("MENU0P",WasX)
  115.      ZNonStop = ZFalse
  116.      ZBypassTimeCheck = ZFalse
  117.      ZLocalUser = ZFalse
  118.      IF NOT ZOK THEN _
  119.      Call getRBBSString(277,RBBSString$) : _                   'Pe 01/26/93
  120.      OutTxt$ = RBBSString$ : _                                 'Pe 01/26/93 
  121.      CALL LPrnt(OutTxt$,1)
  122.      CALL FindItX ("MENUNEW" + ZNodeFileID$ + ".DEF",2)              'RT020993
  123.      IF ZOK Then _                                                   'RT020993
  124.      CALL GetMenuNew  _                                          'Pe020993
  125.      ELSE _                                                          'RT020993
  126.      ZLastSec! = TIMER                                            'RT020993 
  127.      LOCATE 4,62                                                     'MENU1748
  128.      CALL LPrnt(ZEscape$ + "[35;47m" + LEFT$(ZVersionID$,12),0)      'MENU174
  129.      LOCATE 3,76                                                     'MENU1748
  130.      CALL LPrnt(ZNodeID$,0)
  131. '    LOCATE 2,57                                                     'MENU1747
  132. '    CALL AMorPM                                                     'MENU1747
  133. '    CALL LPrnt(ZCurDate$,0)                                         'MENU1747
  134. '    LOCATE 2,69                                                     'MENU1747
  135. '    CALL LPrnt(ZTime$,0)                                            'MENU1747
  136. '    IF ZFMSDirectory$ <> "" THEN _                         
  137. '    LOCATE 14,16 : _                                                'MENU1747
  138. '    CALL LPrnt("YES",0)
  139. '    IF ZExtendedLogging THEN _
  140. '    LOCATE 14,36 : _                                             'MENU1747
  141. '    CALL LPrnt("YES",0)
  142. '    IF ZFossil THEN _
  143. '    LOCATE 16,16 : _                                             'MENU1747
  144. '    CALL LPrnt("YES",0)
  145. '    LOCATE 15,15 : _                                                'MENU1747
  146. '    CALL LPrnt(ZComPort$,0)
  147.      LOCATE 15,4                                                    'MENU1748
  148.      CALL LPrnt (ZEscape$ + "[31;47m" + STR$(CINT(FRE("A")/1024)) + "k",0) 'MENU1748
  149.      IF ZDebug THEN _
  150.      LOCATE 16,4 : _                                             'MENU1748
  151.      CALL LPrnt("Yes",0)
  152.      LOCATE 6,20                                                     'MENU1748
  153.      CALL LPrnt (ZEscape$ + "[34;47m" +  ZMenuNewDate$,0)            'MENU1748
  154.      LOCATE 6,32                                                     'MENU1748
  155.      CALL LPrnt (ZMenuNewTime$,0)                                    'MENU174
  156.      LOCATE 13,4                                                     'MENU1748
  157.      CALL LPrnt (ZEscape$ + "[31;47m" + STR$(ZMenuNewUpld),0)        'MENU1748
  158.      LOCATE 9,4                                                      'MENU1748
  159.      CALL LPrnt (STR$(ZMenuNewUsers),0)                              'MENU174
  160.      LOCATE 8,4                                                      'MENU1748
  161.      CALL LPrnt (STR$(ZMenuNewCalls),0)                              'MENU174
  162.      LOCATE 10,4                                                      'MENU1748
  163.      CALL LPrnt (STR$(ZMenuNewSysop),0)                              'MENU174
  164.      LOCATE 11,4                                                     'MENU1748
  165.      CALL LPrnt (STR$(ZMenuNewDSC),0)                                'MENU1747
  166.      LOCATE 14,4                                                     'MENU1748
  167.      CALL LPrnt (STR$(ZMenuNewDl),0)                                 'MENU1747
  168.      LOCATE 12,4                                                     'MENU1748
  169.      CALL LPrnt (STR$(ZMenuNewDSL),0)                                'MENU1748
  170.      LOCATE 22,14                                                    'MENU1748
  171.      CALL LPrnt (ZEscape$ + "[35;47m" + ZLastOnline$,0)              'MENU1748
  172.      CALL LPrnt (ZEscape$ + "[0;37;47m",0)                           'MENU1748
  173.      End Sub
  174. '
  175. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  176. '  $PAGE
  177. '
  178. '  NAME    --  SysMenu
  179. '
  180. '  INPUTS  --  PARAMETER           MEANING
  181. '
  182. '  OUTPUTS --  NONE
  183. '
  184. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  185. '
  186.     SUB SysMenu STATIC
  187.  
  188.     Call SysMenuPlus (AOK)              'Pe Menu174
  189.     If AOK = ZTrue then _             'Pe Menu174
  190.     Exit Sub
  191.  
  192.     ZLocalUser = ZTrue
  193.     ZSnoop = ZTrue
  194.     ZNonStop = ZTrue
  195.     CALL CheckTime (TIMER, ZDelay!, 1)
  196.     CLS
  197.     ZStopInterrupts = ZTrue
  198.     ZBypassTimeCheck = ZTrue
  199.     CALL BufFile ("MENU0",WasX)
  200.     ZNonStop = ZFalse
  201.     ZBypassTimeCheck = ZFalse
  202.     ZLocalUser = ZFalse
  203.     IF NOT ZOK THEN _
  204.     Call GetRBBSString(277,RBBSString$) : _     'Pe 01/26/93
  205.     OutTxt$ = RBBSString$ : _               'Pe 01/26/93 
  206.     CALL LPrnt(OutTxt$,1)
  207.     LOCATE 2,13
  208.     CALL LPrnt(LEFT$(ZVersionID$,13),0)
  209.     LOCATE 2,42
  210.     CALL LPrnt(ZNodeID$,0)
  211.     LOCATE 2,60
  212.     WasX$ = DATE$
  213.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  214.     LOCATE 2,74
  215.     CALL LPrnt(LEFT$(TIME$,5),0)
  216.     IF ZFMSDirectory$ <> "" THEN _
  217.        LOCATE 6,76 : _
  218.        CALL LPrnt("YES",0)
  219.     IF ZExtendedLogging THEN _
  220.        LOCATE 8,76 : _
  221.        CALL LPrnt("YES",0)
  222.     IF ZFossil THEN _
  223.        LOCATE 10,76 : _
  224.        CALL LPrnt("YES",0)
  225.     LOCATE 12,75 : _
  226.     CALL LPrnt(ZComPort$,0)
  227.     LOCATE 14,75
  228.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  229.     IF ZDebug THEN _
  230.        LOCATE 22,76 : _
  231.        CALL LPrnt("Yes",0)
  232.     END SUB
  233.  
  234.  
  235. Sub LocateMenu (RingBack,ScreenCleared,AOK,FF)  Static
  236.      AOK = ZTrue
  237.      On FF GOTO 1000,2000,3000,4000,5000,6000
  238.      Goto 6001
  239. 1000 LOCATE 19,23                                                    'MENU1744
  240.      IF ZRequiredRings = 0 THEN _
  241.        CALL LPrnt(ZEscape$ + "[0;31;47m" + "WAITING FOR CARRIER",0) : _    'MENU174
  242.      Exit Sub
  243.  
  244.      IF MID$(ZModemInitCmd$, _
  245.      INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
  246.      CALL LPrnt(ZEscape$ + "[0;31;47m" + "RING BACK SYSTEM",0) : _    'MENU1748
  247.      RingBack = ZTrue : _
  248.      Exit Sub
  249.  
  250.      CALL LPrnt(ZEscape$ + "[0;31;47m" + " WAITING FOR RING ",0)      'MENU1748
  251.      Exit Sub
  252.  
  253. 2000 LOCATE 19,40                                                    'MENU1744
  254.      CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
  255.      Exit Sub
  256.  
  257. 3000 LOCATE 18,23                                                    'MENU1744
  258.      IF ZDosANSI THEN _
  259.      CALL LPrnt(ZEscape$ + "[5;31;47m" + "YES" + ZEscape$ + "[00m",0) _
  260.      ELSE CALL LPrnt ("YES",0)
  261.      COLOR ZFG,ZBG,ZBorder
  262.      LOCATE 21,23                                                    'MENU1744
  263.      Exit Sub
  264.  
  265. 4000 LOCATE 19,23                                                    'MENU1744
  266.      CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
  267.      Exit Sub
  268.  
  269. 5000 CALL CheckTime(ZLastSec!, TempElapsed!, 2)                      'RT020993
  270.        
  271. '  Since there is no code in RBBS that displays time down to the second
  272. '  I have had to duplicate a bit of code here   Comment the following lines
  273. '  out if you do not wish the MENU0 screen to display System Idle time.
  274.  
  275.        HOURS! = INT(TempElapsed!/3600)                                 'RT020193
  276.        MIN! = INT((TempElapsed!-(HOURS!*3600))/60)                     'RT020193
  277.        SEC! = INT(TempElapsed!-((HOURS!*3600)+(MIN!*60)))               'RT020193
  278.        IF HOURS! < 10 THEN _                                          'RT020193
  279.   Hou$ = "0"+RIGHT$(STR$(HOURS!),1)_                          'RT020193
  280.        ELSE Hou$ = STR$(HOURS!)                                       'RT020193
  281.        IF MIN! < 10 THEN _                                            'RT020193
  282.   Min$ = "0"+RIGHT$(STR$(MIN!),1)_                            'RT020193
  283.        ELSE Min$ = RIGHT$(STR$(MIN!),2)                               'RT020193
  284.        IF SEC! < 10 THEN _                                            'RT020193
  285.   Sec$ = "0"+RIGHT$(STR$(SEC!),1)_                            'RT020193
  286.        ELSE Sec$ = RIGHT$(STR$(SEC!),2)                               'RT020193
  287.        IF NOT ScreenCleared THEN _
  288.   LOCATE 20,23 : _                                               'RT020193
  289.   CALL LPrnt(Hou$ + ":" + Min$ + ":" + Sec$,0)                   'RT020193
  290.       Exit Sub
  291.  
  292. 6000  LOCATE 19,23                                                     'MENU1744
  293.       CALL LPrnt(TIME$ + " Ring " + _            'MENU174
  294.       STR$(ZWasQ) + ZEscape$ + "[00m",0)                          'MENU174
  295.       Exit Sub
  296.  
  297. 6001 END SUB
  298.  
  299.